home *** CD-ROM | disk | FTP | other *** search
/ Deutsche Edition 1 / Deutsche Edition 1.iso / amok / amok_lha / amok59.lha / AmokEd_V1.02b / txt / EdOErr.mod < prev    next >
Text File  |  1993-08-15  |  6KB  |  307 lines
  1. (*************************************************************************
  2.  
  3. :Program.    EdOErr.mod
  4. :Contents.   Commands for AmokEd
  5. :Author.     Hartmut Goebel
  6. :Language.   Oberon
  7. :Translator. Amiga Oberon Compiler V1.17.1
  8. :Imports.    SupLib (Hartmut Goebel)
  9. :History.    V0.1, 23 Mar 1991 Hartmut Goebel
  10. :Date.       14 Apr 1991 13:08:26
  11.  
  12. *************************************************************************)
  13.  
  14. MODULE EdOErr;
  15.  
  16. IMPORT
  17.   d:   Dos,
  18.   e:   Exec,
  19.   edD: EdDisplay,
  20.   edE: EdErrors,
  21.   edG: EdGlobalVars,
  22.   edK: EdKeyboard,
  23.   edL: EdLowLevel,
  24.   eGd: EdGadgets,
  25.   eMn: EdMenu,
  26.   g:   Graphics,
  27.   I:   Intuition,
  28.   lst: EdLists,
  29.   ol:  OberonLib,
  30.   sl:  SupLib,
  31.   str: Strings,
  32.   sys: SYSTEM;
  33.  
  34. CONST
  35.   MsgFile = "Oberon:Fehler-Meldungen"
  36.   Maxerrs = 256;
  37.  
  38. TYPE
  39.   ObError = STRUCT
  40.     errNum, line, column: LONGINT;
  41.   END;
  42.  
  43. extern PROC *proc;
  44.  
  45. ubyte *ob_msgfile = NULL;
  46. uword errtable[MAXERRS];
  47.  
  48. (* ----------------------------------------------------------------------- *)
  49.  
  50. PROCEDURE obReadBuffer(name: edG.StringPtr;
  51.                    VAR len: LONGINT; errstr: edG.StringPtr): edG.StringPtr;
  52. VAR
  53.   register struct FileLock      *lock,*Lock();
  54.   register struct FileHandle    *handle,*Open();
  55.   register struct FileInfoBlock *fib;
  56.   register ubyte                *buf = 0;
  57.   ubyte                str[80];
  58. BEGIN
  59.   proc->prwindowPtr = (APTR)Ep->Win;
  60.   IF( lock = Lock(name,SHAREDlOCK)) {
  61.     fib = malloc(sizeof(struct FileInfoBlock));
  62.     Examine(lock,fib);
  63.     IF(buf = (ubyte * ) malloc(fib->fibsize)) {
  64.       handle = Open(name, MODEoLDFILE);
  65.       *len = Read(handle,buf,fib->fibsize);
  66.       IF( *len != fib->fibsize) {
  67.         strcpy(str,"error reading ");
  68.         strcat(str, name);
  69.         title(str);
  70.         Abortcommand = 1;
  71.         free(buf);
  72.         buf = 0;
  73.       END;
  74.       Close(handle);
  75.     END; else {
  76.       title("Out of memory error");
  77.       Abortcommand = 1;
  78.     END;
  79.     free(fib);
  80.     UnLock(lock);
  81.   END; else {
  82.     title(errstr);
  83.     Abortcommand = 1;
  84.   END;
  85.   RETURN (buf);
  86. END;
  87.  
  88.  
  89. PROCEDURE obReadErrfile();
  90. VAR
  91.   i, count: LONGINT;
  92.   ptr: edG.StringPtr;
  93.   len: INTEGER;
  94.   str: ARRAY 100 OF CHAR;
  95. BEGIN
  96.   len = str,Length(edG.Text.name);
  97.  
  98.   (* is suffix = ".MOD" *)
  99.   IF len <= 4 THEN RETURN; END;
  100.   IF str.Occurs(edG.Text.name,".mod") # len-4 THEN RETURN; END;
  101.  
  102.   (* read error-file *)
  103.   edL.Copy(sys.ADR(edG.Text.name),str,len);
  104.   str[len] := "e"; str[len+1]  := 0X;
  105.   IF(!(ptr = obReadBuffer(str,&len,"No errors")))
  106.     RETURN;
  107.  
  108.   Ep->errList = (long)ptr;
  109.   Ep->errNum = len / sizeof(obError);
  110.   Ep->lastErr = -1;
  111.  
  112.   sprintf(str,"%ld errors",Ep->errNum);
  113.   title(str);
  114.  
  115.   (* read message-file *)
  116.   strcpy(str,MSGFILE);
  117.   strcat(str," not found");
  118.   IF(!obMsgfile)
  119.     IF(obMsgfile = obReadBuffer(MSGFILE,&len,str)) {
  120.       i = 0;
  121.       count = 1;
  122.       ptr = obMsgfile;
  123.       errtable[0] = 0;
  124.       while( (i < len) && (count < MAXERRS) ) {
  125.         IF( *ptr == '\n') {
  126.           errtable[count++] = i+1;
  127.           *ptr = '\0';
  128.         END;
  129.         ptr++;
  130.         i++;
  131.       END;
  132.     END;
  133.  
  134.   RETURN;
  135. END;
  136.  
  137. PROCEDURE obErrQuit()
  138. BEGIN
  139.   IF(Ep->errList) {
  140.     free(Ep->errList);
  141.     Ep->errList = 0;
  142.     Ep->errNum = 0;
  143.   END;
  144. END obErrQuit;
  145.  
  146. (* error functions ------------------------------------------------------- *)
  147.  
  148. PROCEDURE doReaderrs;
  149. BEGIN
  150.   obErrQuit;
  151.   obReadErrfile;
  152. END doReaderrs;
  153.  
  154.  
  155. PROCEDURE doFirsterr;
  156. {
  157.   IF(Ep->errNum) {
  158.     Ep->lastErr = -1;
  159.     doNexterr();
  160.   END; else {
  161.     title("No errors");
  162.     Abortcommand = 1;
  163.   END;
  164. END;
  165.  
  166. uword dir;
  167.  
  168. PROCEDURE doNexterr;
  169. BEGIN
  170.   dir = 0;
  171.   IF(Ep->errNum) {
  172.     IF(Ep->lastErr < Ep->errNum)
  173.       Ep->lastErr++;
  174.     doCurrenterr();
  175.   END; else {
  176.     title("No errors");
  177.     Abortcommand = 1;
  178.   END;
  179. END doNextErr;
  180.  
  181. PROCEDURE doPreverr;
  182. BEGIN
  183.   dir = 1;
  184.   IF(Ep->errNum) {
  185.     IF(Ep->lastErr > 0) {
  186.       Ep->lastErr--;
  187.       doCurrenterr();
  188.     END; else {
  189.       title("Already first error");
  190.     END;
  191.   END; else {
  192.     title("No errors");
  193.     Abortcommand = 1;
  194.   END;
  195. END doPreverr;
  196.  
  197. PROCEDURE doCurrenterr;
  198. VAR
  199.   obError *err;
  200.   char str[100];
  201.   long *estr;
  202. BEGIN
  203.   IF (IntuitionBase->ActiveWindow != Ep->Win) {
  204.       WindowToFront(Ep->Win);
  205.       ActivateWindow(Ep->Win);
  206.   END;
  207.  
  208.   IF(Ep->errNum == 0) {
  209.     title("No errors");
  210.     Abortcommand = 1;
  211.   END; else {
  212.     IF(Ep->lastErr == -1)
  213.       Ep->lastErr = 0;
  214.  
  215.     IF(Ep->errNum == -1) {
  216.       title("Errorfile confused because of block-operations");
  217.       Abortcommand = 1;
  218.       RETURN;
  219.     END;
  220.  
  221.     IF(Ep->lastErr >= Ep->errNum) {
  222.       title("No more errors");
  223.       Abortcommand = 1;
  224.     END; else {
  225.       textSync();
  226.       err = (obError * ) Ep->errList + Ep->lastErr;
  227.       IF(err->line == -1) {
  228.         IF(dir)
  229.           doPreverr();
  230.         else
  231.           doNexterr();
  232.       END; else {
  233.         Ep->Column = err->column-2;
  234.         IF(Ep->Column < 0)
  235.           Ep->Column = 0;
  236.         IF(err->line <= Ep->Lines) {
  237.           Ep->Line = err->line-1;
  238.           textLoad();
  239.           textSync();
  240.           estr = (long)obMsgfile + (long)errtable[err->errnum];
  241.           sprintf(str,"%ld : %s",
  242.                   Ep->lastErr+1,
  243.                   estr
  244.                   );
  245.           title(str);
  246.         END;
  247.       END;
  248.     END;
  249.   END;
  250. END doCurrenterr;
  251.  
  252. (* line operations ------------------------------------------------------- *)
  253.  
  254. PROCEDURE obErrInsline;
  255. VAR
  256.   register obError *err;
  257.   register int      line = Ep->Line;
  258.   register int      i;
  259. BEGIN
  260.   (* search first error *)
  261.   err = (obError * ) Ep->errList;
  262.   i = 1;
  263.   while((err->line < line) && ( i <= Ep->errNum)) {
  264.     i++;
  265.     err++;
  266.   END;
  267.   (* increment following error-lines *)
  268.   while( i <= Ep->errNum ) {
  269.     IF(err->line != -1)
  270.       err->line++;
  271.     err++;
  272.     i++;
  273.   END;
  274. END obErrInsline;
  275.  
  276. PROCEDURE obErrDeline(line: LONGINT);
  277. VAR
  278.   register obError *err;
  279.   register uword    i;
  280. BEGIN
  281.   line++;
  282.   (* search first error *)
  283.   err = (obError * ) Ep->errList;
  284.   i = 1;
  285.   while((err->line < line) && ( i <= Ep->errNum)) {
  286.     i++;
  287.     err++;
  288.   END;
  289.   while(err->line == line) {
  290.     err->line = -1;
  291.     i++;
  292.     err++;
  293.   END;
  294.   (* decrement following error-lines *)
  295.   while( i <= Ep->errNum ) {
  296.     IF(err->line != -1)
  297.       err->line--;
  298.     err++;
  299.     i++;
  300.   END;
  301. END odErrDeline;
  302.  
  303. (*-----------------------------------------------------------------------*)
  304.  
  305. END EdOErr.
  306.  
  307.